open Constant

let _FOCAL_LENGTH_PATH = [4;2]

(** Raises an error if a gphoto primitive failed *)
let check_ok i msg = if i <> 0 then begin print_endline msg; flush stdout; failwith msg end
(** Just warn if a gphoto primitive failed *)
let ignore_ok i msg = if i <> 0 then begin print_endline msg; flush stdout end
(** Raises an error if a gphoto primitive failed. The message is built lazily *)
let check_ok_lazy i f =	if i <> 0 then begin let msg = f () in print_endline msg; flush stdout; failwith msg end
(** Raises an error a gphoto primitive failed. Otherwise gives back the part of the result that is the actual returned value *)
let check_ok_result (i,r) msg = if i <> 0 then begin print_endline msg; flush stdout; failwith msg end else r

(** Get the camera name 
  @param camera camera pointer
  @return a string 
 *)
let get_name camera =
	let r, abilities = Gphoto2.gp_camera_get_abilities camera in
	if r = 0 then abilities.Gphoto2.model else "Unknown"

(** Loop through all the folders of a camera and perform function f on it. f takes the context, camera and path
    of the folder as arguments. 
		@param context gphoto context
		@param camera the camera containing the store
		@param f the function to perform
		@param root the root folder we start from.
 *)	
let traverse_folder context camera f root = 
	let rec loop_depth root = 
		f context camera root;
		let list = check_ok_result (Gphoto2.gp_list_new ()) "create list" in 
		ignore_ok (Gphoto2.gp_camera_folder_list_folders camera root list context) "get folders of folder";
		let size = Gphoto2.gp_list_count list in
		let rec loop i = 
			if i >= size then begin
				check_ok (Gphoto2.gp_list_free list) "Free list" 
			end else begin 
		  	let ok, folder = Gphoto2.gp_list_get_name list i in 
				loop_depth (root ^ "/" ^folder);
				loop (i+1)
	    end in
	  loop 0 in
	loop_depth root

(** 
  * delete all the pictures present on the camera
	* @param context The gphoto context 
	* @param camera The camera to remove the content from.
	* @param root the root from where the store is cleared. 
	*)	
let delete_all context camera root = 
	let delete_files_in_folder context camera folder =
		ignore_ok (Gphoto2.gp_camera_folder_delete_all camera folder context) "Delete all failed" in
	traverse_folder context camera delete_files_in_folder root

(**
 * Take a thumb photo and return it immediately 
 * @param context gphoto context
 * @param camera camera pointer
 * @param rotate rotation of the thumbname. Takes the name of the file as argument. It must put the image in portrait mode but the rotation is
     inverse for left side and right side pages.
 * @param thumbname name of the thumb on the local store.
 * @return the thumbname argument.
 *)
let take_thumb context camera rotate thumbname=
	let path = check_ok_result (Gphoto2.gp_camera_capture camera Gphoto2.GP_CAPTURE_IMAGE context) "cannot take thumb" in
	let fd = Unix.openfile thumbname  [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0777 in
	let file = check_ok_result (Gphoto2.gp_file_new_from_fd fd) "file creation" in
	check_ok (Gphoto2.gp_camera_file_get camera path.Gphoto2.folder path.Gphoto2.name 
						                           Gphoto2.GP_FILE_TYPE_PREVIEW file context) 
	         "cannot load thumbnail";
	Unix.close fd; 
	check_ok (Gphoto2.gp_camera_file_delete camera path.Gphoto2.folder path.Gphoto2.name context) "delete file";
	rotate thumbname;
	thumbname

(**
 * Take a full photo and return its thumb immediately 
 * @param context gphoto context
 * @param camera camera pointer
 * @param rotate rotation of the thumbname. Takes the name of the file as argument
 * @param thumbname name of the thumb on the local store.
 * @return page describing the photo completely : thumbname and remote name on the camera are filled in.
 *)
let take_photo context camera rotate thumbname =
	let path = 
		check_ok_result (Gphoto2.gp_camera_capture camera Gphoto2.GP_CAPTURE_IMAGE context) (Printf.sprintf "cannot take photo %s" thumbname) in 
	if !debug then Printf.printf "Photo taken on %s\n" path.Gphoto2.name; flush stdout;
	let fd = Unix.openfile thumbname  [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0777 in
	let file = check_ok_result (Gphoto2.gp_file_new_from_fd fd) "file creation" in
	check_ok (Gphoto2.gp_camera_file_get camera path.Gphoto2.folder path.Gphoto2.name 
																			 Gphoto2.GP_FILE_TYPE_PREVIEW file context)
			 	   "cannot load thumbnail";
	Unix.close fd; 
	rotate thumbname;
	{ camera_path = path; thumbname = thumbname; loaded = None }


let load_photo context camera rotate generate_image_name page =
	match page.loaded with
		| None -> 
				let filename = generate_image_name () in
				let path = page.camera_path in
				let fd = Unix.openfile filename [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0777 in
				let file = check_ok_result (Gphoto2.gp_file_new_from_fd fd) "new file" in
				check_ok (Gphoto2.gp_camera_file_get camera path.Gphoto2.folder path.Gphoto2.name 
						                                 Gphoto2.GP_FILE_TYPE_NORMAL file context)
				         "cannot get photo";
				Unix.close fd;
				rotate filename;
				page.loaded <-Some filename
		| _ -> () 
	

(** Get a camera according to a list of abilities port info list 
 * @param context the gphoto context
 * @param abilities list of abilities
 * @param camera_paths list of discovered cameras. 
 * @param ports list of available ports.
 * @i index in the paths
 *)

let init_camera context abilities camera_paths ports i = 
	let path = check_ok_result (Gphoto2.gp_list_get_value camera_paths i) "Path not ok" in
	let name = check_ok_result (Gphoto2.gp_list_get_name camera_paths i) "Get name failed" in
	if !debug then Printf.printf "Trying to connect to %s (%d) at %s\n" name i path;
	let index = Gphoto2.gp_abilities_list_lookup_model abilities name in
	let abilities = check_ok_result (Gphoto2.gp_abilities_list_get_abilities abilities index) "Get abilities failed" in
	let index = Gphoto2.gp_port_info_list_lookup_path ports path in
	let port_info = check_ok_result (Gphoto2.gp_port_info_list_get_info ports index) "get info not ok" in
	let port_name : string = check_ok_result (Gphoto2.gp_port_info_get_name port_info) "get port name not ok" in
	let port_path : string = check_ok_result (Gphoto2.gp_port_info_get_path port_info) "get port path not ok" in
	if !debug then Printf.printf "Got name = %s path = %s\n" port_name port_path;
	let camera = check_ok_result (Gphoto2.gp_camera_new()) "new camera failed" in
	check_ok (Gphoto2.gp_camera_set_abilities camera abilities) "set abilities not ok";
	check_ok (Gphoto2.gp_camera_set_port_info camera port_info) "set port info not ok";
	check_ok (Gphoto2.gp_camera_init camera context) "init is not ok";
	if !debug then Printf.printf "Connection performed\n"; flush stdout;
	let stores, n = Gphoto2.gp_camera_get_storeinfo camera context in
	let store = stores.(0) in
	let basedir = store.Gphoto2.store_basedir in
	let fingerprint = name ^ string_of_int store.Gphoto2.store_capacity ^ store.Gphoto2.store_label in  
	camera, basedir, fingerprint

let rec access_config full_path = function 
  [] -> full_path
| (pos :: tail) -> 
		let next_ptr = 
			check_ok_result (Gphoto2.gp_widget_get_child (List.hd full_path) pos) "No such configuration path" in
	  let label = check_ok_result (Gphoto2.gp_widget_get_label next_ptr) "no label" in
		if !debug then Printf.printf "label of element %d - %s\n" pos label;
		
		access_config (next_ptr :: full_path) tail 


class camera context abilities camera_paths ports i =
	let camera, basedir, fingerprint = init_camera context abilities camera_paths ports i in
	let digest = Digest.to_hex (Digest.string fingerprint) in
	let root_ptr = check_ok_result (Gphoto2.gp_camera_get_config camera context) "get config" in
	let focal_length = access_config [root_ptr] _FOCAL_LENGTH_PATH in
	let ok, min_focus, max_focus, step = Gphoto2.gp_widget_get_range (List.hd focal_length) in
	let initial_focus = check_ok_result (Gphoto2.gp_widget_get_value_float (List.hd focal_length)) "get initial focus" in
  let round_focus v = let c_step = floor ((v -. min_focus) /. step) in min_focus +. c_step *. step in
	let set_focus v = 
		let v_rounded = round_focus v in 
		check_ok (Gphoto2.gp_widget_set_value_float (List.hd focal_length) v_rounded) "Cannot modify focus";
		check_ok (Gphoto2.gp_camera_set_config camera root_ptr context) "Cannot set focus" in
	object(self)
		val mutable rotate = (function (_ : string) -> ())
		val mutable focus = initial_focus
		method name = get_name camera
		method take_thumb thumbname = take_thumb context camera rotate thumbname
		method take_photo thumbname = take_photo context camera rotate thumbname
		method load_page gen_name page = load_photo context camera rotate gen_name page
		method wipe_all = delete_all context camera basedir
		method set_focus v = focus <- v; set_focus v
		method get_focus = focus
		method get_focus_range = (min_focus, max_focus, step)
		method set_rotate f = rotate <- f
		method digest = digest
  end

let configure_cameras() =
  let context = Gphoto2.gp_context_new() in
  let _,camera_paths = Gphoto2.gp_list_new() in
  let _,abilities = Gphoto2.gp_abilities_list_new() in
  let _,ports = Gphoto2.gp_port_info_list_new() in
	check_ok (Gphoto2.gp_port_info_list_load ports) "load port info not ok";
  check_ok (Gphoto2.gp_abilities_list_load abilities context) "load abilities not ok";
	let c1 = Gphoto2.gp_port_info_list_count ports in
	if !debug then Printf.printf "Number of port info %d\n" c1;
	let c2 = Gphoto2.gp_abilities_list_count abilities in
	if !debug then Printf.printf "Number of known abilities %d\n" c2;
	check_ok (Gphoto2.gp_abilities_list_detect abilities ports camera_paths context) "Camera detection not ok";
	let c3 = Gphoto2.gp_list_count camera_paths in
	if !debug then Printf.printf "Camera found %d\n" c3;
	flush stdout;
	if (c3 = 3) then begin
		let camera1 = new camera context abilities camera_paths ports 1 in
		let camera2 = new camera context abilities camera_paths ports 2 in
		Some camera1, Some camera2
  end else if (c3 = 2) then begin
		let camera1 = new camera context abilities camera_paths ports 0 in
		let opt_camera2 = 
			try Some (new camera context abilities camera_paths ports 1) with _ -> None in
		Some camera1, opt_camera2
	end else if c3 = 1 then begin
		let camera = new camera context abilities camera_paths ports 0 in
		Some camera, None
	end else (None, None)
										
																		
																			